EJERCICIO DE EVALUACIÓN I

ANÁLISIS DE COMPONENTES PRINCIPALES Y CLUSTER

1.Calcular la matriz de correlaciones, y su representación gráfica ¿Cuáles son las variables más correlacionadas de forma inversa?

Provincias<- read_excel("Provincias.xlsx",sheet = 1) 
datos<- as.data.frame(Provincias) 
rownames(datos)<-datos[,1] 
datos<-datos[,-1]
Est<-stat.desc(datos,basic=FALSE)
knitr::kable(Est, digits =2,caption = "Estadísticos descriptivos")
Estadísticos descriptivos
Poblacion Mortalidad Natalidad IPC NumEmpresas Industria Construccion CTH Infor AFS APT TasaActividad TasaParo Ocupados PIB CANE TVF VS
median 6.147230e+05 9.12 8.98 102.32 3.800000e+04 2516.00 5070.00 15488.00 369.50 813.50 5440.50 57.79 19.51 222.40 1.188364e+07 14037.00 3.359340e+05 5.641150e+04
mean 8.994489e+05 9.38 8.84 102.35 6.128612e+04 3807.77 7804.79 23741.21 1131.88 1378.31 10853.50 57.84 21.17 347.09 2.027514e+07 19034.54 4.847812e+05 7.079935e+04
SE.mean 1.600722e+05 0.29 0.30 0.11 1.255286e+04 669.75 1452.44 4184.44 413.68 286.83 2829.49 0.56 0.97 67.43 4.544660e+06 1978.57 7.458945e+04 8.016740e+03
CI.mean.0.95 3.213584e+05 0.59 0.60 0.23 2.520092e+04 1344.58 2915.90 8400.61 830.50 575.85 5680.44 1.13 1.94 135.38 9.123786e+06 3972.14 1.497446e+05 1.609428e+04
var 1.332402e+12 4.50 4.57 0.67 8.193867e+09 23325284.46 109698956.01 910495895.62 8898914.50 4278261.00 416313032.73 16.34 48.59 236460.60 1.074005e+15 203565500.80 2.893064e+11 3.341943e+09
std.dev 1.154297e+06 2.12 2.14 0.82 9.051998e+04 4829.63 10473.73 30174.42 2983.10 2068.40 20403.75 4.04 6.97 486.27 3.277201e+07 14267.64 5.378721e+05 5.780954e+04
coef.var 1.280000e+00 0.23 0.24 0.01 1.480000e+00 1.27 1.34 1.27 2.64 1.50 1.88 0.07 0.33 1.40 1.620000e+00 0.75 1.110000e+00 8.200000e-01

De los estadísticos mostrados observamos que existe bastante dispersión entre las provincias.

xyplot(PIB ~ TasaActividad, data =datos)

xyplot(PIB ~ IPC, data =datos)

xyplot(PIB ~ NumEmpresas, data =datos)

Sólo vemos una clara relación de tipo directo entre el número de empresas y el PIB. Con la tasa de actividad y el IPC vemos que hay relación directa también pero quizá los casos atípicos no nos permitan verla con mayor claridad.

R<-cor(datos, method="pearson")
knitr::kable(R, digits =2,caption = "Correlaciones")
Correlaciones
Poblacion Mortalidad Natalidad IPC NumEmpresas Industria Construccion CTH Infor AFS APT TasaActividad TasaParo Ocupados PIB CANE TVF VS
Poblacion 1.00 -0.34 0.11 0.33 0.99 0.96 0.98 1.00 0.94 0.99 0.98 0.33 0.01 1.00 0.98 0.10 0.99 0.57
Mortalidad -0.34 1.00 -0.74 0.19 -0.31 -0.28 -0.30 -0.33 -0.26 -0.31 -0.30 -0.73 -0.46 -0.33 -0.30 0.02 -0.33 -0.25
Natalidad 0.11 -0.74 1.00 -0.25 0.11 0.09 0.09 0.10 0.11 0.10 0.11 0.47 0.38 0.11 0.11 -0.12 0.08 -0.03
IPC 0.33 0.19 -0.25 1.00 0.36 0.42 0.40 0.36 0.30 0.32 0.33 0.09 -0.58 0.36 0.36 -0.19 0.34 0.19
NumEmpresas 0.99 -0.31 0.11 0.36 1.00 0.97 0.99 0.99 0.96 0.99 0.99 0.33 -0.06 1.00 0.99 0.04 0.98 0.54
Industria 0.96 -0.28 0.09 0.42 0.97 1.00 0.97 0.98 0.89 0.95 0.93 0.29 -0.08 0.96 0.94 0.12 0.97 0.57
Construccion 0.98 -0.30 0.09 0.40 0.99 0.97 1.00 0.99 0.96 0.98 0.98 0.34 -0.11 0.99 0.99 0.03 0.98 0.56
CTH 1.00 -0.33 0.10 0.36 0.99 0.98 0.99 1.00 0.93 0.98 0.97 0.33 -0.01 0.99 0.97 0.09 0.99 0.58
Infor 0.94 -0.26 0.11 0.30 0.96 0.89 0.96 0.93 1.00 0.97 0.99 0.31 -0.11 0.96 0.99 -0.07 0.91 0.41
AFS 0.99 -0.31 0.10 0.32 0.99 0.95 0.98 0.98 0.97 1.00 0.99 0.32 -0.03 0.99 0.99 0.09 0.98 0.54
APT 0.98 -0.30 0.11 0.33 0.99 0.93 0.98 0.97 0.99 0.99 1.00 0.33 -0.08 0.99 1.00 -0.01 0.96 0.48
TasaActividad 0.33 -0.73 0.47 0.09 0.33 0.29 0.34 0.33 0.31 0.32 0.33 1.00 0.03 0.35 0.33 -0.12 0.33 0.26
TasaParo 0.01 -0.46 0.38 -0.58 -0.06 -0.08 -0.11 -0.01 -0.11 -0.03 -0.08 0.03 1.00 -0.05 -0.10 0.39 0.01 0.10
Ocupados 1.00 -0.33 0.11 0.36 1.00 0.96 0.99 0.99 0.96 0.99 0.99 0.35 -0.05 1.00 0.99 0.05 0.98 0.54
PIB 0.98 -0.30 0.11 0.36 0.99 0.94 0.99 0.97 0.99 0.99 1.00 0.33 -0.10 0.99 1.00 -0.01 0.96 0.47
CANE 0.10 0.02 -0.12 -0.19 0.04 0.12 0.03 0.09 -0.07 0.09 -0.01 -0.12 0.39 0.05 -0.01 1.00 0.15 0.34
TVF 0.99 -0.33 0.08 0.34 0.98 0.97 0.98 0.99 0.91 0.98 0.96 0.33 0.01 0.98 0.96 0.15 1.00 0.67
VS 0.57 -0.25 -0.03 0.19 0.54 0.57 0.56 0.58 0.41 0.54 0.48 0.26 0.10 0.54 0.47 0.34 0.67 1.00
corrplot(R, type="upper", order="hclust",tl.col="black", tl.srt=90)

Las variables más correlacionadas negativamente son Natalidad con Mortalidad (-74%) y luego TasaActividad con Mortalidad (-73%)
fit<-PCA(datos,scale.unit=TRUE,ncp=7,graph=TRUE)

eig<-get_eigenvalue(fit)
knitr::kable(eig, digits =2,caption = "Autovalores")
Autovalores
eigenvalue variance.percent cumulative.variance.percent
Dim.1 11.47 63.70 63.70
Dim.2 2.56 14.23 77.93
Dim.3 1.63 9.08 87.01
Dim.4 0.93 5.19 92.19
Dim.5 0.46 2.54 94.73
Dim.6 0.41 2.30 97.03
Dim.7 0.31 1.71 98.74
Dim.8 0.12 0.65 99.39
Dim.9 0.07 0.41 99.79
Dim.10 0.02 0.11 99.91
Dim.11 0.01 0.05 99.96
Dim.12 0.00 0.02 99.98
Dim.13 0.00 0.01 99.99
Dim.14 0.00 0.00 99.99
Dim.15 0.00 0.00 100.00
Dim.16 0.00 0.00 100.00
Dim.17 0.00 0.00 100.00
Dim.18 0.00 0.00 100.00
fviz_eig(fit,addlabels=TRUE)

fviz_eig(fit,geom="line")+theme_grey()

Vemos que la dimension 1 recoge bastante de la variabilidad con más de 60%. Viendo la gráfica podríamos tomar 3 componentes para recoger casi el 90% de la variabilidad o 4 componentes para tener poco más del 90%.

2. Realizar un análisis de componentes principales sobre la matriz de correlaciones,calculando 7 componentes. Estudiar los valores de los autovalores obtenidos y las gráficas que los resumen. ¿Cuál es el número adecuado de componentes?

a. Mostrar los coeficientes para obtener las componentes principales ¿Cuál es la expresión para calcular la primera Componente en función de las variables originales?

fit<-PCA(datos,scale.unit=TRUE,ncp=7,graph=TRUE)

knitr::kable(fit$svd$V, digits =3,caption = "Autovectores")
## Warning in kable_pipe(x = structure(c("0.294", "-0.106", "0.041", "0.110", : The
## table should have a header (column names)
Autovectores
0.294 0.002 0.050 -0.053 0.016 0.009 -0.067
-0.106 -0.527 0.189 -0.161 -0.024 -0.034 0.195
0.041 0.495 -0.271 -0.110 0.382 0.313 0.588
0.110 -0.365 -0.262 0.435 0.557 0.351 -0.328
0.294 -0.026 0.008 -0.069 0.006 -0.007 -0.017
0.286 -0.045 0.046 0.023 0.150 0.062 0.065
0.293 -0.045 -0.012 -0.026 -0.008 -0.006 0.027
0.293 -0.011 0.049 -0.028 0.028 0.047 -0.068
0.282 -0.042 -0.065 -0.222 -0.070 -0.126 0.051
0.292 -0.016 0.040 -0.092 -0.003 -0.055 0.019
0.291 -0.029 -0.028 -0.142 -0.032 -0.080 0.008
0.114 0.331 -0.363 0.463 -0.133 -0.529 -0.186
-0.014 0.462 0.387 -0.220 0.055 0.304 -0.591
0.294 -0.017 0.002 -0.060 0.001 -0.040 -0.023
0.291 -0.036 -0.037 -0.134 0.009 -0.077 0.009
0.018 0.096 0.657 0.278 0.488 -0.419 0.200
0.292 -0.002 0.100 0.044 -0.047 0.074 -0.006
0.172 0.048 0.290 0.567 -0.503 0.431 0.257

Podemos ver las provincias de Madrid y Barcelona están bien representadas por la componente 1. Dicha componente recoge muchas de las variables, no destacando alguna en particular ya que varias tienen como coeficiente valores alrededor de 0.29.

Donde: CP1:0.041* Poblacion+0.110* Mortalidad+ 0.294* Natalidad+…..0.172* VS

b. Mostar una tabla con las correlaciones de las Variables con las Componentes Principales. Para cada Componente indicar las variables con las que está más correlacionada

var<-get_pca_var(fit)
knitr::kable(var$cor, digits =2,caption = "Correlaciones de la CP con
las variables")
Correlaciones de la CP con las variables
Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7
Poblacion 0.99 0.00 0.06 -0.05 0.01 0.01 -0.04
Mortalidad -0.36 -0.84 0.24 -0.16 -0.02 -0.02 0.11
Natalidad 0.14 0.79 -0.35 -0.11 0.26 0.20 0.33
IPC 0.37 -0.58 -0.34 0.42 0.38 0.23 -0.18
NumEmpresas 1.00 -0.04 0.01 -0.07 0.00 0.00 -0.01
Industria 0.97 -0.07 0.06 0.02 0.10 0.04 0.04
Construccion 0.99 -0.07 -0.02 -0.03 -0.01 0.00 0.01
CTH 0.99 -0.02 0.06 -0.03 0.02 0.03 -0.04
Infor 0.95 -0.07 -0.08 -0.21 -0.05 -0.08 0.03
AFS 0.99 -0.03 0.05 -0.09 0.00 -0.04 0.01
APT 0.98 -0.05 -0.04 -0.14 -0.02 -0.05 0.00
TasaActividad 0.39 0.53 -0.46 0.45 -0.09 -0.34 -0.10
TasaParo -0.05 0.74 0.50 -0.21 0.04 0.20 -0.33
Ocupados 1.00 -0.03 0.00 -0.06 0.00 -0.03 -0.01
PIB 0.99 -0.06 -0.05 -0.13 0.01 -0.05 0.00
CANE 0.06 0.15 0.84 0.27 0.33 -0.27 0.11
TVF 0.99 0.00 0.13 0.04 -0.03 0.05 0.00
VS 0.58 0.08 0.37 0.55 -0.34 0.28 0.14
corrplot(var$cor,is.corr=FALSE)

  Podemos ver numéricamente y gráficamente el nivel de las correlaciones donde CP1 contiene la información de las variables relacionadas a desarrollo económico y población, CP2 destaca por la relación inversa con la tasa de mortalidad y directa tasa de natalidad y con tasa de paro. CP3 tiene relación con CANE y la CP4 tiene relaciones media con IPC, Tasa Actividad y Viviendas secundarias (VS).

c. Comentar los gráficos que representan las variables en los planos formados por las componentes, intentando explicar lo que representa cada componente

# Representación gráfica variables 1 y 2
fviz_pca_var(fit, axes = c(1, 2), col.var="cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE )

# Representación gráfica variables 3 y 4
fviz_pca_var(fit, axes = c(3, 4), col.var="cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE )

 La componente 1 representa a: Población,NumEmpresas,Industria,Construccion,CTH,Infor,AFS,APT,Ocupados,PIB,TVF (estas variables estaban muy correlacionadas entre sí)

La componente 2 a representa a:

Tasa Paro, Natalidad, Mortalidad en menor medida y tasa actividad

La componente 3 a representa a: 

CANE , Tasa Paro en menor medida Tasa Actividad

La componente 4 a representa a:

IPC y VS

d. Mostrar la tabla y los gráficos que nos muestran la proporción de la varianza de cada variable que es explicado por cada componente. ¿Cuál de las variables es la que está peor explicada?

knitr::kable(var$cos2, digits =2,caption = "Cosenos al cuadrado")
Cosenos al cuadrado
Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7
Poblacion 0.99 0.00 0.00 0.00 0.00 0.00 0.00
Mortalidad 0.13 0.71 0.06 0.02 0.00 0.00 0.01
Natalidad 0.02 0.63 0.12 0.01 0.07 0.04 0.11
IPC 0.14 0.34 0.11 0.18 0.14 0.05 0.03
NumEmpresas 0.99 0.00 0.00 0.00 0.00 0.00 0.00
Industria 0.94 0.01 0.00 0.00 0.01 0.00 0.00
Construccion 0.99 0.01 0.00 0.00 0.00 0.00 0.00
CTH 0.98 0.00 0.00 0.00 0.00 0.00 0.00
Infor 0.91 0.00 0.01 0.05 0.00 0.01 0.00
AFS 0.98 0.00 0.00 0.01 0.00 0.00 0.00
APT 0.97 0.00 0.00 0.02 0.00 0.00 0.00
TasaActividad 0.15 0.28 0.22 0.20 0.01 0.12 0.01
TasaParo 0.00 0.55 0.25 0.05 0.00 0.04 0.11
Ocupados 0.99 0.00 0.00 0.00 0.00 0.00 0.00
PIB 0.97 0.00 0.00 0.02 0.00 0.00 0.00
CANE 0.00 0.02 0.70 0.07 0.11 0.07 0.01
TVF 0.97 0.00 0.02 0.00 0.00 0.00 0.00
VS 0.34 0.01 0.14 0.30 0.12 0.08 0.02
# Representación gráfica de los cosenos 
corrplot(var$cos2,is.corr=FALSE)

#Porcentaje de variabilidad explicada por las 4 CP 
fviz_cos2(fit,choice="var",axes=1:4)

La variables con menos representación en las 4 componentes es IPC ya que el coseno (correlaciones al cuadrado) alcanza el 75% mientras que por ejemplo NumEmpresas alcanza casi el 100%.

e. Mostrar la tabla y los gráficos que nos muestran el porcentaje de la varianza de cada Componente que es debido a cada variable. ¿Que variables contribuyen más a cada Componente?

knitr::kable(var$contrib, digits =2,caption = "Contribuciones")
Contribuciones
Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7
Poblacion 8.62 0.00 0.25 0.29 0.03 0.01 0.45
Mortalidad 1.13 27.79 3.57 2.60 0.06 0.11 3.79
Natalidad 0.17 24.54 7.33 1.20 14.60 9.83 34.58
IPC 1.21 13.35 6.88 18.93 31.00 12.30 10.79
NumEmpresas 8.65 0.07 0.01 0.48 0.00 0.00 0.03
Industria 8.16 0.20 0.22 0.05 2.25 0.38 0.42
Construccion 8.60 0.21 0.01 0.07 0.01 0.00 0.07
CTH 8.58 0.01 0.24 0.08 0.08 0.22 0.46
Infor 7.92 0.18 0.42 4.91 0.50 1.58 0.26
AFS 8.55 0.03 0.16 0.84 0.00 0.30 0.03
APT 8.45 0.09 0.08 2.01 0.10 0.64 0.01
TasaActividad 1.31 10.93 13.16 21.44 1.77 27.93 3.46
TasaParo 0.02 21.30 15.00 4.85 0.31 9.25 34.98
Ocupados 8.67 0.03 0.00 0.36 0.00 0.16 0.06
PIB 8.46 0.13 0.14 1.79 0.01 0.59 0.01
CANE 0.03 0.93 43.13 7.75 23.82 17.58 3.99
TVF 8.50 0.00 1.00 0.19 0.22 0.54 0.00
VS 2.97 0.23 8.42 32.16 25.26 18.56 6.62
corrplot(var$contrib,is.corr=FALSE)

#Contribución de las variables a la Componente 1
fviz_contrib (fit, choice="var", axes=1, top= 10)

#Contribución de las variables a la Componente 2
fviz_contrib (fit, choice="var", axes=2, top= 10)

#Contribución de las variables a la Componente 3
fviz_contrib (fit, choice="var", axes=3, top= 10)

#Contribución de las variables a la Componente 4
fviz_contrib (fit, choice="var", axes=4, top= 10)

Respecto a la componente 1 ésta se representa por 10 variables de forma casi equitativa: Ocupados, NumEmpresas, Poblacion,Construccion,CTH - CTH. Comercio, transporte y hostelería (nº empresas)-, AFS -AFS. Actividades financieras y de seguros (nº empresas), TVF -TVF. Censo 2011: Total viviendas familiares-, PIB, APT -APT. Actividades profesionales y técnicas (nº empresas)-, Industria.

Respecto a la componente 2 en ésta destacan 5 variables: Mortalidad, Natalidad, TasaParo, IPC, Tasa Actividad.

Respecto a la componente 3 en ésta destacan 1 variable: CANE -Censo Agrario Número de Explotaciones-, en menor medida le siguen: TasaParo, TasaActividad, VS -Censo 2011: Viviendas secundarias-,Nataidad, IPC, etc.

Respecto a la componente 4 en ésta destacan VS -Censo 2011: Viviendas secundarias-,TasaActividad, IPC, etc.

f. Sobre los gráficos que representan las observaciones en los nuevos ejes y el gráfico Biplot., teniendo en cuenta la posición de las provincias en el gráfico ¿Comentar las provincias que tienen una posición más destacada en cada ¿componente, en positivo o negativo, ¿Qué significa esto en términos socioeconómicos para estas provincias?

fviz_pca_ind(fit,axes = c(1, 2), col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), repel = TRUE)

Observamos que MAdrid y Barcelona destacan en la componente 1 relacionada con números de empresas y población principalmente. Se podría decir que son ciudades más desarrolladas en cuanto a esas variables. Luego Melilla, Ceuta, Almería son 3 provincias que destacan en la componente 2 relacionada con Mortalidad, Natalidad, TasaParo, IPC, Tasa Actividad. Se podría decir que tienen baja mortalidad con buena tasa de natalidad pero poco desarrolladas.

fviz_pca_ind(fit,axes = c(2, 3), col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE)

fviz_pca_ind(fit,axes = c(1, 3), col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE)

Las provincias de Jaen y Valencia destacan respecto a las demás por su representación en la componente 3 relacionada con CANE -Censo Agrario Número de Explotaciones. Se podría decir que son provincias agrícolas pero Valencia es más desarrollada por su posición en el componente 1.

fviz_pca_ind(fit,axes = c(3, 4), col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE)

fviz_pca_ind(fit,axes = c(1, 4), col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE)

Las provincias de Alicante y Valencia destacan en las componentes 3 y 4 donde la 3 está relacionada con CANE (Censo Agrario Número de Explotaciones) y la 4 con VS (Viviendas secundarias). SE podría decir Por otro lado está la provincia de Balears que tiene una representación similar en la componente 4 pero en el extremo opuesto de la componente 3.

g. Si tuviéramos que construir un índice que valore de forma conjunta el desarrollo económico de una provincia, como se podría construir utilizando una combinación lineal de todas las variables. ¿Cuál sería el valor de dicho índice en Madrid? ¿Cual sería su valor en Melilla?

El índice podría estar representado por la componente 1 ya que esta es una representación lineal de las variables que tienen relacion con el desarrollo económico, como vimos: CP1:0.041* Poblacion+0.110* Mortalidad+ 0.294* Natalidad+…..0.172* VS

ind<-get_pca_ind(fit) 
knitr::kable(ind$coord, digits =3,caption = "Valores de los individuos en las Cp")
Valores de los individuos en las Cp
Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7
Albacete -1.410 0.473 0.096 -0.458 0.131 -0.379 -0.033
Alicante 3.384 0.540 1.919 2.420 -1.938 1.799 0.821
Almería -0.617 2.614 0.208 -0.142 -0.042 0.050 -0.083
Álava -1.444 -0.001 -2.032 -0.113 0.468 0.094 0.288
Asturias -0.204 -1.953 1.298 -0.714 -0.369 0.017 0.362
Badajoz -1.048 1.168 1.796 -0.854 0.075 -0.575 0.100
Balears 1.526 0.260 -2.519 2.364 0.481 -0.567 -0.652
Barcelona 13.683 -1.612 -0.867 -0.279 1.040 0.765 -0.500
Bizkaia 0.576 -1.508 -1.180 -0.383 0.798 0.466 -0.213
Burgos -1.202 -1.550 -0.892 0.989 0.602 0.532 -0.458
Cantabria -0.849 -1.126 -0.594 0.401 -0.131 0.391 -0.103
Castellón -0.690 0.821 0.518 0.382 -0.548 -0.294 0.627
Ceuta -2.125 3.326 -1.811 -1.165 0.298 0.648 0.029
Ciudad Real -1.392 0.815 1.819 -0.774 0.216 -0.565 -0.219
Coruña 0.635 -1.442 0.759 0.244 0.258 -0.046 0.293
Cuenca -2.132 -0.569 1.048 -0.932 -0.478 -0.080 0.246
Cáceres -1.503 -0.180 1.269 -0.223 -0.041 0.074 -0.416
Cádiz 0.128 1.771 0.369 -0.249 -0.259 1.273 -1.427
Córdoba -0.594 0.811 1.292 -0.169 1.084 -0.014 -0.662
Gipuzkoa -0.281 -1.485 -1.879 0.266 1.184 0.484 -0.209
Girona 0.388 0.544 -1.387 1.638 -0.629 0.508 0.101
Granada -0.072 1.124 1.511 0.500 0.723 -0.090 -0.362
Guadalajara -1.408 1.542 -1.849 0.906 -0.788 -1.017 -0.304
Huelva -1.265 1.168 0.013 -0.327 0.073 0.930 -0.731
Huesca -1.776 -0.984 -0.587 0.304 -0.290 -0.793 0.331
Jaén -1.221 1.424 3.407 -0.479 1.428 -1.000 -0.265
León -1.464 -2.016 0.877 -0.809 -0.240 0.665 -0.113
Lleida -0.835 -0.136 -1.472 1.185 0.741 -0.924 0.136
Lugo -1.826 -2.785 0.871 -0.353 0.324 -0.161 0.398
Madrid 16.778 -0.366 -0.849 -2.365 -0.880 -0.974 0.424
Melilla -2.218 4.782 -1.905 -2.231 0.714 1.410 1.854
Murcia 1.522 1.442 0.580 0.901 0.437 0.406 0.595
Málaga 2.006 1.325 0.869 1.104 -0.357 0.738 -0.349
Navarra -0.653 0.078 -1.096 -0.081 0.229 -0.704 0.612
Ourense -1.965 -2.858 1.098 -1.204 -0.325 0.888 0.142
Palencia -2.122 -1.951 -0.695 -0.142 0.050 0.041 -0.395
Palmas 0.092 1.857 -0.330 -0.824 -1.375 -0.550 -1.284
Pontevedra 0.036 -0.607 0.052 -0.328 -0.016 0.419 -0.310
Rioja -1.383 -0.484 -1.354 0.288 0.201 -0.243 0.226
Salamanca -1.612 -1.425 -0.121 -0.086 -0.577 -0.243 0.306
Santa Cruz -0.029 1.573 -0.126 -0.432 -1.560 -0.747 -0.941
Segovia -1.931 -1.015 -1.110 0.263 -0.266 -0.399 0.197
Sevilla 1.948 1.775 0.712 -0.546 0.549 -0.205 -0.509
Soria -2.399 -1.857 -0.778 -0.503 -0.656 -0.420 0.352
Tarragona 0.175 1.040 -0.102 1.512 -0.537 -0.225 0.323
Teruel -2.185 -1.082 -0.351 -0.413 -0.516 -0.404 0.525
Toledo -0.461 1.449 0.812 0.463 0.047 -0.764 0.144
Valencia 4.770 0.360 2.961 2.349 0.919 -0.284 0.907
Valladolid -1.007 -0.704 -1.052 0.196 0.290 0.082 -0.312
Zamora -2.287 -3.169 0.578 -0.622 0.167 0.635 -0.282
Zaragoza 0.115 -0.237 -0.156 0.068 0.142 -0.822 0.675
Ávila -2.152 -0.982 0.365 -0.545 -0.851 0.171 0.118

Madrid tnedría una valor de 16.778, le seguiría Barcelon con 13.683. Melilla tendría un valor de -2.218, es decir bajo desarrollo, comparado a la media=0

4. Representar un mapa de calor de la matriz de datos, estandarizado y sin estandarizar

para ver si se detectan inicialmente grupos de provincias.

tabla1<-summary(datos)
knitr::kable(tabla1, caption = "Tabla resumen de las variables") 
Tabla resumen de las variables
Poblacion Mortalidad Natalidad IPC NumEmpresas Industria Construccion CTH Infor AFS APT TasaActividad TasaParo Ocupados PIB CANE TVF VS
Min. : 84509 Min. : 5.820 Min. : 5.550 Min. :100.6 Min. : 3749 Min. : 75 Min. : 309 Min. : 2030 Min. : 35.0 Min. : 50.0 Min. : 504 Min. :47.41 Min. :11.95 Min. : 24.6 Min. : 1397441 Min. : 3 Min. : 26233 Min. : 200
1st Qu.: 322203 1st Qu.: 7.855 1st Qu.: 7.700 1st Qu.:101.9 1st Qu.: 22822 1st Qu.: 1704 1st Qu.: 2972 1st Qu.: 9243 1st Qu.: 185.5 1st Qu.: 486.8 1st Qu.: 3091 1st Qu.:55.45 1st Qu.:15.39 1st Qu.: 132.4 1st Qu.: 6509393 1st Qu.: 9758 1st Qu.: 211628 1st Qu.: 38941
Median : 614723 Median : 9.120 Median : 8.975 Median :102.3 Median : 38000 Median : 2516 Median : 5070 Median : 15488 Median : 369.5 Median : 813.5 Median : 5440 Median :57.79 Median :19.51 Median : 222.4 Median : 11883640 Median :14037 Median : 335934 Median : 56412
Mean : 899449 Mean : 9.379 Mean : 8.839 Mean :102.4 Mean : 61286 Mean : 3808 Mean : 7805 Mean : 23741 Mean : 1131.9 Mean : 1378.3 Mean : 10854 Mean :57.84 Mean :21.17 Mean : 347.1 Mean : 20275145 Mean :19035 Mean : 484781 Mean : 70799
3rd Qu.:1019030 3rd Qu.:10.688 3rd Qu.: 9.610 3rd Qu.:102.7 3rd Qu.: 65083 3rd Qu.: 4106 3rd Qu.: 8350 3rd Qu.: 27567 3rd Qu.: 868.2 3rd Qu.: 1429.2 3rd Qu.: 10627 3rd Qu.:60.07 3rd Qu.:27.75 3rd Qu.: 389.8 3rd Qu.: 21242697 3rd Qu.:26020 3rd Qu.: 532066 3rd Qu.: 80625
Max. :6454440 Max. :14.360 Max. :19.330 Max. :104.8 Max. :508612 Max. :27416 Max. :59661 Max. :158331 Max. :19058.0 Max. :12357.0 Max. :123863 Max. :68.69 Max. :37.18 Max. :2806.4 Max. :198652445 Max. :68037 Max. :2894679 Max. :326705
heatmaply(datos, seriate = "mean", row_dend_left = TRUE,  plot_method = "plotly")
#Al ser interactivo no se puede exportar a pdf y usar la alternativa de abajo
#ggheatmap(as.matrix(datos),seriate="mean")

No apreciamos un matiz de colores, casi en todas las variables los valores están muy juntos. Destacan Barcelona y Madrid por sus colores muy claros en el PIB.

#Calculamos las distancias con los valores sin estandarizar #Mostramos las primeras seis filas dela matriz de distancias

d <- dist(datos, method = "euclidean") # distance matrix
d6<-as.matrix(d)[1:6, 1:6]
knitr::kable(d6, digits =2,caption = "Distancias") 
Distancias
Albacete Alicante Almería Álava Asturias Badajoz
Albacete 0 24971242 4687257 3481471.5 14555211 3362039.7
Alicante 24971242 0 20284171 21510859.3 10424490 21610942.1
Almería 4687257 20284171 0 1277176.4 9869791 1328833.4
Álava 3481472 21510859 1277176 0.0 11088936 452219.3
Asturias 14555211 10424490 9869791 11088935.7 0 11197887.0
Badajoz 3362040 21610942 1328833 452219.3 11197887 0.0
#Representamos gráficamente la matriz de distancias
fviz_dist(d, show_labels = TRUE)

#Reordenamos para agrupar las observaciones que están más próximas y visualizar los posibles clusters

ggheatmap(as.matrix(d), seriate="mean")

ggheatmap(as.matrix(d), seriate="OLO")

#según el criterio de ward #Dibujamos el dendograma correspondiente

res.hc <- hclust(d, method="ward.D2") 

fviz_dend(res.hc, cex = 0.5)

Estandarizamos

#first 6 rows

datos_ST <- scale(datos)
head(datos_ST, nrow = 6)
##           Poblacion  Mortalidad   Natalidad         IPC NumEmpresas   Industria
## Albacete -0.4352968  0.01459982  0.08469908 -0.64825299 -0.38207162 -0.09851058
## Alicante  0.8394624 -0.65028156 -0.14907757 -0.05020505  0.76394056  1.28047827
## Almería  -0.1713258 -1.16426788  1.20215149 -1.09373769 -0.23154132 -0.33476077
## Álava    -0.5003190 -0.78231475  0.66446518  0.47949457 -0.46109285 -0.36436969
## Asturias  0.1406112  1.31135430 -1.20574805 -0.34190598  0.06810524 -0.06455350
## Badajoz  -0.1806466  0.07590094  0.05664588 -1.60390921 -0.23913080 -0.15503670
##          Construccion        CTH      Infor         AFS         APT
## Albacete  -0.41788262 -0.4185734 -0.3160749 -0.36468248 -0.37127978
## Alicante   0.91784057  0.9603758  0.2410627  0.66074991  0.44165900
## Almería   -0.23074771 -0.1841696 -0.2567408 -0.20997321 -0.24571463
## Álava     -0.49034966 -0.5363553 -0.2711553 -0.49521843 -0.36819211
## Asturias   0.06017071  0.1426303 -0.1156126  0.03224349 -0.01252221
## Badajoz   -0.30607906 -0.1763484 -0.2681383 -0.20803934 -0.27536604
##          TasaActividad   TasaParo    Ocupados         PIB       CANE        TVF
## Albacete   -0.02968476  0.3022945 -0.41600241 -0.39787472  0.1299067 -0.4998087
## Alicante    0.09152801  0.3180755  0.69921672  0.36202242  0.4859572  1.4674767
## Almería     0.69017067  1.4213109 -0.23174345 -0.25526238  0.2740791 -0.1667593
## Álava       0.00494746 -1.1251688 -0.44026866 -0.29168563 -1.0754084 -0.6116959
## Asturias   -1.58813466 -0.6029611  0.08618552  0.04562699  0.3417147  0.2400641
## Badajoz    -0.45516632  1.2132886 -0.25189677 -0.29579447  1.2898744 -0.2087637
##                   VS
## Albacete -0.70153382
## Alicante  4.42670296
## Almería   0.02917605
## Álava    -1.05533357
## Asturias  0.04239186
## Badajoz  -0.36946059
#Calculamos las distancias con los valores estandarizados

d_st <- dist(datos_ST, method = "euclidean") # distance matrix
d_st6<-as.matrix(d_st)[1:6, 1:6]
knitr::kable(d_st6, digits =2,caption = "Distancias") 
Distancias
Albacete Alicante Almería Álava Asturias Badajoz
Albacete 0.00 6.60 2.37 2.45 3.11 1.92
Alicante 6.60 0.00 6.07 7.35 5.90 6.35
Almería 2.37 6.07 0.00 3.68 4.77 2.39
Álava 2.45 7.35 3.68 0.00 4.20 4.22
Asturias 3.11 5.90 4.77 4.20 0.00 3.37
Badajoz 1.92 6.35 2.39 4.22 3.37 0.00
#Visualizamos

fviz_dist(d_st)

#Barcelona y MAdrid son diferentes a los demas

heatmaply(as.matrix(d_st), seriate = "OLO", row_dend_left = TRUE,  plot_method = "plotly")
res.hc_st <- hclust(d_st, method="ward.D2") 
fviz_dend(res.hc_st, cex = 0.5)

5. Realizar un análisis Jerárquico de clusters para determinar si existen grupos de provincias con comportamiento similar.

a. A la vista del dendrograma ¿Cuántos clusters recomendarías?

#Seleccionaremos 4 grupos
grp<-cutree(res.hc_st, k=4)
head(grp,n=4)
## Albacete Alicante  Almería    Álava 
##        1        2        3        1
#Número de miembros en cada cluster
knitr::kable(table(grp),caption="Numero de individuos por cluster")
Numero de individuos por cluster
grp Freq
1 31
2 2
3 17
4 2
#podemos ver las provincias de los clusters
rownames(datos)[grp == 1]
##  [1] "Albacete"    "Álava"       "Asturias"    "Balears"     "Bizkaia"    
##  [6] "Burgos"      "Cantabria"   "Coruña"      "Cuenca"      "Cáceres"    
## [11] "Gipuzkoa"    "Girona"      "Guadalajara" "Huesca"      "León"       
## [16] "Lleida"      "Lugo"        "Navarra"     "Ourense"     "Palencia"   
## [21] "Pontevedra"  "Rioja"       "Salamanca"   "Segovia"     "Soria"      
## [26] "Tarragona"   "Teruel"      "Valladolid"  "Zamora"      "Zaragoza"   
## [31] "Ávila"
rownames(datos)[grp == 2]
## [1] "Alicante" "Valencia"
rownames(datos)[grp == 3]
##  [1] "Almería"     "Badajoz"     "Castellón"   "Ceuta"       "Ciudad Real"
##  [6] "Cádiz"       "Córdoba"     "Granada"     "Huelva"      "Jaén"       
## [11] "Melilla"     "Murcia"      "Málaga"      "Palmas"      "Santa Cruz" 
## [16] "Sevilla"     "Toledo"
rownames(datos)[grp == 4]
## [1] "Barcelona" "Madrid"

b. Representar los individuos agrupados según el número de clusters elegido.

fviz_dend(res.hc_st, k = 4, # Cut in four groups
          cex = 0.5, # label size
          k_colors = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
          color_labels_by_k = TRUE, # color labels by groups
          rect = TRUE) # Add rectangle around groups

fviz_cluster(list(data = d_st, cluster = grp),
             palette = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"), 
             ellipse.type = "convex", # Concentration ellipse
             repel = TRUE, # Avoid label overplotting (slow)
             show.clust.cent = FALSE, ggtheme = theme_minimal())

Vemos cierto traslape en los clusters 2 y 3

# class(datos_ST)
# 
#datos[rownames(datos)!='Barcelona',]
#datos[!rownames(datos)%in%c('Barcelona','Madrid'),]

c. ¿Qué número óptimo de clusters nos indican los criterios Silhoutte y de Elbow?

#para clustering jeraquico:

#Determinación delnúmero óptimo de clusters
# Elbow method
fviz_nbclust(datos_ST, hcut, method = "wss") +
  geom_vline(xintercept =3, linetype = 2)+
  labs(subtitle = "Elbow method")

# Silhouette method
fviz_nbclust(datos_ST, hcut, method = "silhouette")+
  labs(subtitle = "Silhouette method")

En ambos método se ve que existen 2 cluster claramente diferenciados, quizá si retiramos a Madrid y Barcelona nos podrían salir más grupos.

datos_sin<-datos[!rownames(datos)%in%c('Barcelona','Madrid'),]
datos_ST_sin <- scale(datos_sin)
d_st_sin <- dist(datos_ST_sin, method = "euclidean")

res.hc_st_sin <- hclust(d_st_sin, method="ward.D2") 
fviz_dend(res.hc_st_sin, cex = 0.5)

#para clustering jeraquico:

#Determinación delnúmero óptimo de clusters
# Elbow method
fviz_nbclust(datos_ST_sin, hcut, method = "wss") +
  geom_vline(xintercept =3, linetype = 2)+
  labs(subtitle = "Elbow method")

# Silhouette method
fviz_nbclust(datos_ST_sin, hcut, method = "silhouette")+
  labs(subtitle = "Silhouette method")

Entonces nos quedamos con 2 cluster más el cluster Barcelona-Madrid que habíamos retirado serían 3 clusters

d. Con el número de clusters decidido en el apartado anterior realizar un agrupamiento no jerárquico.

RNGkind(sample.kind = "Rejection")
set.seed(1234)

km.res <- kmeans(datos_ST, 3)
head(km.res$cluster, 20)
##    Albacete    Alicante     Almería       Álava    Asturias     Badajoz 
##           2           1           1           2           2           1 
##     Balears   Barcelona     Bizkaia      Burgos   Cantabria   Castellón 
##           1           3           2           2           2           1 
##       Ceuta Ciudad Real      Coruña      Cuenca     Cáceres       Cádiz 
##           1           1           2           2           2           1 
##     Córdoba    Gipuzkoa 
##           1           2
print(km.res)
## K-means clustering with 3 clusters of sizes 23, 27, 2
## 
## Cluster means:
##     Poblacion Mortalidad  Natalidad        IPC NumEmpresas   Industria
## 1  0.04846141 -0.7378253  0.5361929 -0.4678304 -0.01772688 -0.02758061
## 2 -0.36789805  0.6953741 -0.4947207  0.2733647 -0.32333852 -0.30172394
## 3  4.40931744 -0.9025593  0.5125104  1.6896263  4.56892924  4.39045012
##   Construccion         CTH      Infor         AFS         APT TasaActividad
## 1  -0.03934538  0.03456157 -0.1129017 -0.00473118 -0.05627375     0.5005539
## 2  -0.30171894 -0.35670840 -0.2505702 -0.32596935 -0.29539322    -0.5182922
## 3   4.52567761  4.41810542  4.6810676  4.45499479  4.63495671     1.2405756
##     TasaParo     Ocupados         PIB       CANE         TVF         VS
## 1  0.8314882 -0.001142574 -0.06862329  0.4076102  0.08632346  0.3701857
## 2 -0.6613562 -0.333431668 -0.28485815 -0.2959366 -0.38534053 -0.4253843
## 3 -0.6338058  4.514467117  4.63475280 -0.6923738  4.20937736  1.4855534
## 
## Clustering vector:
##    Albacete    Alicante     Almería       Álava    Asturias     Badajoz 
##           2           1           1           2           2           1 
##     Balears   Barcelona     Bizkaia      Burgos   Cantabria   Castellón 
##           1           3           2           2           2           1 
##       Ceuta Ciudad Real      Coruña      Cuenca     Cáceres       Cádiz 
##           1           1           2           2           2           1 
##     Córdoba    Gipuzkoa      Girona     Granada Guadalajara      Huelva 
##           1           2           1           1           1           1 
##      Huesca        Jaén        León      Lleida        Lugo      Madrid 
##           2           1           2           2           2           3 
##     Melilla      Murcia      Málaga     Navarra     Ourense    Palencia 
##           1           1           1           2           2           2 
##      Palmas  Pontevedra       Rioja   Salamanca  Santa Cruz     Segovia 
##           1           2           2           2           1           2 
##     Sevilla       Soria   Tarragona      Teruel      Toledo    Valencia 
##           1           2           1           2           1           1 
##  Valladolid      Zamora    Zaragoza       Ávila 
##           2           2           2           2 
## 
## Within cluster sum of squares by cluster:
## [1] 214.26326  95.53694  13.70956
##  (between_SS / total_SS =  64.8 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

i. Representar los clusters formados en los planos de las Componentes principales. Relacionar la posición de cada cluster en el plano con lo que representa cada componente principal.

# Visualize clusters using factoextra
fviz_cluster(km.res, datos_ST)

Apreciamos que el cluster MAdrid-Barcelona está muy a la derecha de la media en el componente 1 , esta componente estaba representado por las variables de desarrollo económico y población. Respecto a la componente 2 hay 2 grupos los que están por encima y por debajo de la media, esta componente está representado por las variables de tasa de paro y natalidad principalmente.

#Determinación delnúmero óptimo de clusters
# Elbow method
fviz_nbclust(datos_ST, kmeans, method = "wss") +
  geom_vline(xintercept =3, linetype = 2)+
  labs(subtitle = "Elbow method")

# Silhouette method
fviz_nbclust(datos_ST, kmeans, method = "silhouette")+
  labs(subtitle = "Silhouette method")

ii. Evaluar la calidad de los clusters

sil <- silhouette(km.res$cluster, dist(datos_ST))
rownames(sil) <- rownames(datos)
head(sil[, 1:3])
##          cluster neighbor  sil_width
## Albacete       2        1 0.23404690
## Alicante       1        2 0.12861643
## Almería        1        2 0.23985301
## Álava          2        1 0.33700472
## Asturias       2        1 0.38504449
## Badajoz        1        2 0.03338686
fviz_silhouette(sil)
##   cluster size ave.sil.width
## 1       1   23          0.08
## 2       2   27          0.41
## 3       3    2          0.66

En el cluster 1 encontramos provincias con silueta negativa por lo que podríamos pensar que están mal clasificadas. Las provincias de Albacete, Navarra, Alava y otra más están en la media del componente 2 y podrían estar generando dichas siluetas.

Probemos otro número de k.

RNGkind(sample.kind = "Rejection")
set.seed(1234)
km.res_reducido <- kmeans(datos_ST, 2)
fviz_cluster(km.res_reducido, datos_ST)

sil <- silhouette(km.res_reducido$cluster, dist(datos_ST))
rownames(sil) <- rownames(datos)
fviz_silhouette(sil)
##   cluster size ave.sil.width
## 1       1    2          0.67
## 2       2   50          0.76

Con k=2 no hay siluetas negativas sin embargo tener sólo 2 clusters puede resultar en ser poco útil por lo que caracterizaremos 3.

e. Explicar las provincias que forman cada uno de los clusters y comentar cuales son las características socioeconómicas que las hacen pertenecer a dicho cluster.

EsT_Clus<-aggregate(datos, by=list(km.res$cluster),mean)
knitr::kable(EsT_Clus, digits =2,caption = "Estadísticos de los clusters") 
Estadísticos de los clusters
Group.1 Poblacion Mortalidad Natalidad IPC NumEmpresas Industria Construccion CTH Infor AFS APT TasaActividad TasaParo Ocupados PIB CANE TVF VS
1 955387.7 7.81 9.99 101.97 59681.48 3674.57 7392.70 24784.09 795.09 1368.52 9705.30 59.86 26.97 346.53 18026222 24850.17 531212.2 92199.61
2 474785.2 10.85 7.78 102.57 32017.52 2350.56 4644.67 12977.74 384.41 704.07 4826.37 55.74 16.56 184.95 10939771 14812.22 277517.3 46208.07
3 5989112.0 7.46 9.94 103.73 474865.50 25012.00 55205.50 157055.00 15096.00 10593.00 105424.00 62.86 16.75 2542.35 172165306 9156.00 2748888.0 156678.50

Finalmente vemos que el cluster 3 tiene alta población y altos números de empresas de los diferentes rubros. Al ser tan marcada las diferencias con respecto al resto pareciera que no hubiesen diferencia significativa entre los cluster 1 y 2 pero sí las hay en todas las variables (donde hay poca es en tasaactividad 59.86 vs 55.74) por lo que se debe tener cuidado en este tipo de casos.